home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 04 - 1988 / 04.05 May 88 / mpw PalFun Stuff / PalFun.p < prev    next >
Encoding:
Text File  |  1988-04-14  |  22.4 KB  |  985 lines  |  [TEXT/MPS ]
  1. {        PalFun by Steve Sheets 3/88    }
  2.  
  3. {        Palette Manager Sample Program designed for MacTutor.    } 
  4. {        It demonstrate various Palette Animation effects.    }
  5.  
  6. PROGRAM PalFun;
  7.  
  8. USES    MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, PaletteMgr, PickerIntf;
  9.  
  10. CONST    appleM = 301;                {Menu ID Constants}
  11.             fileM = 302;
  12.             editM = 303;
  13.             winM = 304;
  14.             menuCount = 304;
  15.             
  16.             numWindows = 9;            {Window ID Constants}
  17.             redW = 1;
  18.             greenW = 2;
  19.             blueW = 3;
  20.             curW = 4;
  21.             ballW = 5;
  22.             shapeW = 6;
  23.             rainbowW = 7;
  24.             fadeW = 8;
  25.  
  26.             StrID = 300;                {Various Resource ID Constants}
  27.             AlertID = 300;
  28.             FadeID = 300;
  29.             ShapeID = 301;
  30.  
  31.             MaxCT = 2048;                {Max Numbers in CLUT (usually only use 256}
  32.  
  33.             ColorInc = $200;        {Amount difference between Color rings}
  34.             ColorStart = $FE00;    {Start Color Rings}
  35.  
  36. {My Version of the CLUT data structure (used for stuffing values).}
  37. TYPE    MyCSpecArray = ARRAY[0..MaxCT] OF ColorSpec;
  38.  
  39.             MyCTabHandle = ^MyCTabPtr;
  40.             MyCTabPtr = ^MyColorTable;
  41.             MyColorTable = RECORD
  42.                     ctSeed : LONGINT;
  43.                     ctFlag : INTEGER;
  44.                     ctSize : INTEGER;
  45.                     ctTable : MyCSpecArray;
  46.             END;
  47.             
  48. {Standard Variables (Menus, Window Pointer, Window Record)}
  49. {And Palette Handles (1 per Window). }
  50. VAR    myMenus : ARRAY[appleM..menuCount] OF MenuHandle;
  51.         MyWindow : ARRAY[1..numWindows] of WindowPtr;
  52.         MyPalette : ARRAY[1..numWindows] of PaletteHandle;
  53.         dragRect : Rect;
  54.         doneFlag : BOOLEAN;
  55.         
  56. {******************** General Tools ********************}
  57.  
  58. {Returns true if the Mac had Color Quickdraw.}
  59. FUNCTION ColorQDExists : boolean;
  60.     CONST
  61.         ROM85Loc = $28E;
  62.         TwoHighMask = $C000;
  63.     TYPE
  64.         WordPtr = ^INTEGER;
  65.     VAR
  66.         Wd : WordPtr;
  67. BEGIN
  68.     Wd := POINTER(ROM85Loc);
  69.     ColorQDExists := (BitAnd(Wd^, TwoHighMask) = 0);
  70. END;
  71.  
  72. {Stuffs Red, Green & Blue into RGBColor}
  73. PROCEDURE SetRGB(VAR RGB:RGBColor;R,G,B:INTEGER);
  74. BEGIN
  75.     RGB.Red:=R;
  76.     RGB.Green:=G;
  77.     RGB.Blue:=B;
  78. END;
  79.  
  80. {Copies RGBColor into RGBColor}
  81. PROCEDURE CopyRGB(RGBsrc:RGBColor;VAR RGBdest:RGBColor);
  82. BEGIN
  83.     RGBdest.Red:=RGBsrc.Red;
  84.     RGBdest.Green:=RGBsrc.Green;
  85.     RGBdest.Blue:=RGBsrc.Blue;
  86. END;
  87.  
  88. {Delays a set length time.  usually until}
  89. { the screen in refreshed (prevents ripples)}
  90. PROCEDURE DoDelay(N:INTEGER);
  91. VAR L:LONGINT;
  92. BEGIN
  93.     L:=TickCount+N;
  94.     WHILE L>TickCount DO ;
  95. END;
  96.         
  97. {Using 16 Bit Unsigned Integers: C:=A/B}
  98. PROCEDURE UnSignedDiv(A,B:INTEGER;VAR C:INTEGER);
  99. VAR L:LongInt;
  100. BEGIN
  101.     IF A<0 
  102.         THEN L:=A+65536
  103.         ELSE L:=A;
  104.     C:=LoWord(L DIV B);
  105. END;
  106.  
  107. {Using 16 Bit Unsigned Integers: A:=A+B}
  108. PROCEDURE UnSignedAdd(VAR A:INTEGER;B:INTEGER);
  109. VAR L:LongInt;
  110. BEGIN
  111.     IF A<0 
  112.         THEN L:=A+65536+B
  113.         ELSE L:=A+B;
  114.     A:=LoWord(L);
  115. END;
  116.  
  117. {Using 16 Bit Unsigned Integers: A:=A-B}
  118. PROCEDURE UnSignedSub(VAR A:INTEGER;B:INTEGER);
  119. VAR L:LongInt;
  120. BEGIN
  121.     IF A<0 
  122.         THEN L:=A+65536-B
  123.         ELSE L:=A-B;
  124.     A:=LoWord(L);
  125. END;
  126.  
  127. {******************** Color Table Tools ********************}
  128.  
  129. {Given number of Colors to be placed in it, creates a blank CLUT.  Gives it}
  130. {    an unique Seed and correct value, but no colors.}
  131. FUNCTION NewCT (N : integer) : CTabHandle;
  132.     VAR
  133.         MyCT : MyCTabHandle;
  134.         count : integer;
  135. BEGIN
  136.     MyCT := NIL;
  137.     IF (N > 0) AND (N <= MaxCT) THEN
  138.         BEGIN
  139.             MyCT := POINTER(NewHandle((N * SIZEOF(ColorSpec)) + (2 * SIZEOF(integer)) + SIZEOF(longint)));
  140.             IF MyCT <> NIL THEN
  141.                 WITH MyCT^^ DO
  142.                     BEGIN
  143.                         ctSeed := GetCTSeed;
  144.                         ctFlag := 0;
  145.                         ctSize := N - 1;
  146.                         FOR count := 0 TO N - 1 DO
  147.                             WITH ctTable[count] DO
  148.                                 BEGIN
  149.                                     value := count;
  150.                                     SetRGB(rgb,0,0,0);
  151.                                 END;
  152.                     END;
  153.         END;
  154.     NewCT := POINTER(MyCT);
  155. END;
  156.  
  157. {Stuffs an RGB value in the Nth Color (numbered 0 to N) of the CLUT.}
  158. PROCEDURE SetCTEntry (C : CTabHandle;
  159.                                 N, R, G, B : INTEGER);
  160.     VAR
  161.         MyCT : MyCTabHandle;
  162. BEGIN
  163.     MyCT := POINTER(C);
  164.     SetRGB(MyCT^^.ctTable[n].rgb,R,G,B);
  165. END;
  166.  
  167. {******************** Red ********************}
  168.  
  169. {Red Window displays encompassing red-shaded circles.}
  170. {This creates a 3-D Globe effect.}
  171.  
  172. {Create Red Window/Palette with NewPalette & SetEntryColor commands.}
  173. PROCEDURE MakeRed;
  174. VAR    tempRect : rect;
  175.         tempRGB : RGBColor;
  176.         S : str255;
  177.         count : integer;
  178. BEGIN
  179.     SetRect(tempRect, 20, 40, 320, 340);
  180.     GetIndString(S, StrID, 1);
  181.     MyWindow[redW] := NewCWindow(nil, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  182.  
  183.     MyPalette[redW] := NewPalette(128, NIL, pmTolerant, 0);
  184.     SetRGB(tempRGB,ColorStart,0,0);
  185.     FOR count := 0 TO 127 DO
  186.         BEGIN
  187.             SetEntryColor(MyPalette[redW], count, tempRGB);
  188.             UnSignedSub(tempRGB.red,ColorInc);
  189.         END;
  190.  
  191.     SetPalette(MyWindow[redW], MyPalette[redW], true);
  192. END;
  193.  
  194. {Draw the Red Window using RGBForeColor.}
  195. PROCEDURE DoRedUpdate;
  196.     VAR
  197.         tempRect : rect;
  198.         tempRGB : RGBColor;
  199.         count : integer;
  200. BEGIN
  201.     SetRect(tempRect, 22, 22, 278, 278);
  202.     SetRGB(tempRGB,ColorStart,0,0);
  203.     FOR count := 0 TO 127 DO
  204.         BEGIN
  205.             RGBForeColor(tempRGB);
  206.             PaintOval(tempRect);
  207.             InsetRect(tempRect, 1, 1);
  208.             UnSignedSub(tempRGB.red,ColorInc);
  209.         END;
  210. END;
  211.  
  212. {******************** Green ********************}
  213.  
  214. {Green Window displays a Green Globe.}
  215.  
  216. {Create Green Window/Palette with NewPalette command & CLUT  procedures.}
  217. PROCEDURE MakeGreen;
  218. VAR    tempRect : rect;
  219.         tempRGB : RGBColor;
  220.         tempCT : CTabHandle;
  221.         Col : INTEGER;
  222.         S : str255;
  223.         count : integer;
  224. BEGIN
  225.     SetRect(tempRect, 40, 60, 340, 360);
  226.     GetIndString(S, StrID, 2);
  227.     MyWindow[greenW] := NewCWindow(nil, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  228.  
  229.     tempCT := NewCT(128);
  230.     Col := ColorStart;
  231.     FOR count := 0 TO 127 DO
  232.         BEGIN
  233.             SetCTEntry(tempCT, count, 0, Col, 0);
  234.             UnSignedSub(Col,ColorInc);
  235.         END;
  236.     MyPalette[greenW] := NewPalette(128, tempCT, pmTolerant, 0);
  237.     DisposHandle(Handle(tempCT));
  238.  
  239.     SetPalette(MyWindow[greenW], MyPalette[greenW], true);
  240. END;
  241.  
  242. {Draw the Green Window using PmForeColor.}
  243. PROCEDURE DoGreenUpdate;
  244.     VAR
  245.         tempRect : rect;
  246.         count : integer;
  247. BEGIN
  248.     SetRect(tempRect, 22, 22, 278, 278);
  249.     FOR count := 0 TO 127 DO
  250.         BEGIN
  251.             PmForeColor(count);
  252.             PaintOval(tempRect);
  253.             InsetRect(tempRect, 1, 1);
  254.         END;
  255. END;
  256.  
  257. {******************** Blue ********************}
  258.  
  259. {Display a Blue Globe (like Green Window), but now the colors }
  260. {are set up for better displaying (ie. Color Priority).}
  261.  
  262. {Create Green Window/Palette with NewPalette command & CLUT  procedures.}
  263.  
  264. PROCEDURE MakeBlue;
  265. VAR    tempRect : rect;
  266.         tempRGB : RGBColor;
  267.         tempCT : CTabHandle;
  268.         Col : INTEGER;
  269.         S : str255;
  270.         h, v : integer;
  271. BEGIN
  272.     SetRect(tempRect, 60, 80, 360, 380);
  273.     GetIndString(S, StrID, 3);
  274.     MyWindow[blueW] := NewCWindow(nil, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  275.  
  276.     tempCT := NewCT(128);
  277.     Col := ColorStart;
  278.     FOR h := 0 TO 15 DO
  279.         FOR v := 0 TO 7 DO
  280.             BEGIN
  281.                 SetCTEntry(tempCT, (v * 16) + h, 0, 0, Col);
  282.                 UnSignedSub(Col,ColorInc);
  283.             END;
  284.     MyPalette[blueW] := NewPalette(128, tempCT, pmTolerant, 0);
  285.     DisposHandle(Handle(tempCT));
  286.  
  287.     SetPalette(MyWindow[blueW], MyPalette[blueW], true);
  288. END;
  289.  
  290. {Draw the Blue Window using RGBForeColor.}
  291. PROCEDURE DoBlueUpdate;
  292.     VAR
  293.         tempRect : rect;
  294.         tempRGB : RGBColor;
  295.         count : integer;
  296. BEGIN
  297.     SetRect(tempRect, 22, 22, 278, 278);
  298.     SetRGB(tempRGB,0,0,ColorStart);
  299.     FOR count := 0 TO 127 DO
  300.         BEGIN
  301.             RGBForeColor(tempRGB);
  302.             PaintOval(tempRect);
  303.             InsetRect(tempRect, 1, 1);
  304.             UnSignedSub(tempRGB.Blue,ColorInc);
  305.         END;
  306. END;
  307.  
  308. {******************** Current Color ********************}
  309.  
  310. {Displays the Current Color Enviroment}
  311.  
  312. {Create the current Color Window using Explicit colors }
  313. {(Does not have to set the colors).}
  314. PROCEDURE MakeCur;
  315. VAR    tempRect : rect;
  316.         S : str255;
  317. BEGIN
  318.     SetRect(tempRect, 100, 80, 420, 400);
  319.     GetIndString(S, StrID, 4);
  320.     MyWindow[curW] := NewCWindow(nil, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  321.     MyPalette[curW] := NewPalette(256, NIL, pmExplicit, 0);
  322.     SetPalette(MyWindow[curW], MyPalette[curW], true);
  323. END;
  324.  
  325. {Draws the current Graphic Device Colors.}
  326. PROCEDURE DoCurUpdate;
  327.     VAR
  328.         x, y, n : integer;
  329.         tempRect : rect;
  330. BEGIN
  331.     n := 0;
  332.     FOR y := 0 TO 15 DO
  333.         FOR x := 0 TO 15 DO
  334.             BEGIN
  335.                 PmForeColor(n);
  336.                 SetRect(tempRect, x * 20, y * 20, (x + 1) * 20, (y + 1) * 20);
  337.                 PaintRect(tempRect);
  338.                 n := n + 1;
  339.             END;
  340. END;
  341.  
  342. {******************** Ball ********************}
  343.  
  344. {Simple Palette Animation of a Ball Across the Screen}
  345.  
  346. {Create the Ball Animation Window using Animated colors.}
  347. PROCEDURE MakeBall;
  348. VAR    tempRect : rect;
  349.         tempRGB : RGBColor;
  350.         S : str255;
  351.         count : integer;
  352. BEGIN
  353.     SetRect(tempRect, 100, 120, 400, 420);
  354.     GetIndString(S, StrID, 5);
  355.     MyWindow[ballW] := NewCWindow(nil, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  356.     MyPalette[ballW] := NewPalette(19, NIL, pmAnimated, 0);
  357.  
  358.     SetRGB(tempRGB,$FFFF,$FFFF,$FFFF);
  359.     SetEntryColor(MyPalette[ballW], 0, tempRGB);
  360.     SetRGB(tempRGB,0,0,0);
  361.     SetEntryColor(MyPalette[ballW], 1, tempRGB);
  362.     tempRGB.blue := $FFFF;
  363.     SetEntryColor(MyPalette[ballW], 2, tempRGB);
  364.     tempRGB.blue := 0;
  365.     tempRGB.red := $FFFF;
  366.     FOR count := 3 TO 18 DO
  367.         SetEntryColor(MyPalette[ballW], count, tempRGB);
  368.     SetPalette(MyWindow[ballW], MyPalette[ballW], true);
  369. END;
  370.  
  371. {Draw the Balls in the window using PmForeColor.}
  372. PROCEDURE DoBallUpdate;
  373.     VAR
  374.         R : rect;
  375.         count : integer;
  376. BEGIN
  377.     SetRect(R, 0, 0, 10000, 10000);
  378.     PmForeColor(18);
  379.     PaintRect(R);
  380.  
  381.     FOR count := 2 TO 17 DO
  382.         BEGIN
  383.             R.top := 16 * count;
  384.             R.left := R.top;
  385.             R.bottom := R.top + 16;
  386.             R.right := R.bottom;
  387.             PmForeColor(count);
  388.             PaintOval(R);
  389.         END;
  390. END;
  391.  
  392. {Animate the Ball through the window using AnimateEntry.}
  393. PROCEDURE AnimBall;
  394.     VAR
  395.         R, B : RGBcolor;
  396.         time, count, temp : integer;
  397. BEGIN
  398.     SetRGB(R,$FFFF,0,0);
  399.  
  400.     SetRGB(B,0,0,$FFFF);
  401.  
  402.     FOR time := 1 TO 10 DO
  403.         FOR count := 2 TO 17 DO
  404.             BEGIN
  405.                 IF count = 17
  406.                     THEN temp := 2
  407.                     ELSE temp:=count+1;
  408.                 DoDelay(1);
  409.                 AnimateEntry(MyWindow[ballW], count, R);
  410.                 AnimateEntry(MyWindow[ballW], temp, B);
  411.             END;
  412. END;
  413.  
  414. {******************** Shape ********************}
  415.  
  416. {Given 3 arbitrary regions (Black/White images), calculates how}
  417. {to draw the window so that the images can be shuffled through
  418. {quickly.}
  419.  
  420. {Create the Shape Animation Window}
  421. {('pltt' is automatically loaded in).}
  422. PROCEDURE MakeShape;
  423. BEGIN
  424.     MyWindow[shapeW] := GetNewCWindow(ShapeID, nil, POINTER(-1));
  425. END;
  426.  
  427. {Draws Shape.  aRgn,bRgn,cRgn are the arbitrary images.}
  428. PROCEDURE DoShapeUpdate;
  429. VAR aRgn,bRgn,cRgn,TempRgn: RgnHandle;
  430.         count:INTEGER;
  431.         TempRect:Rect;
  432.     PROCEDURE DrawTriag(h,v:INTEGER);
  433.     BEGIN
  434.         MoveTo(h+25,v);
  435.         Line(-25,50);
  436.         Line(50,0);
  437.         Line(-25,-50);
  438.     END;
  439. BEGIN
  440.     aRgn:=NewRgn;
  441.     OpenRgn;
  442.         SetRect(tempRect,10,10,60,60);
  443.         FrameOval(tempRect);
  444.         SetRect(tempRect,120,10,170,60);
  445.         FrameRect(tempRect);
  446.         SetRect(tempRect,120,80,170,130);
  447.         FrameRect(tempRect);
  448.         SetRect(tempRect,190,10,240,60);
  449.         FrameRect(tempRect);
  450.         SetRect(tempRect,190,80,240,130);
  451.         FrameRect(tempRect);
  452.         SetRect(tempRect,10,80,110,81);
  453.         FOR count:=1 TO 25 DO BEGIN
  454.             FrameRect(tempRect);
  455.             OffSetRect(tempRect,0,2);
  456.         END;
  457.     CloseRgn(aRgn);
  458.     bRgn:=NewRgn;
  459.     OpenRgn;
  460.         SetRect(tempRect,35,10,85,60);
  461.         FrameOval(tempRect);
  462.         SetRect(tempRect,120,10,170,60);
  463.         FrameOval(tempRect);
  464.         SetRect(tempRect,120,80,170,130);
  465.         FrameOval(tempRect);
  466.         SetRect(tempRect,190,10,240,60);
  467.         FrameOval(tempRect);
  468.         SetRect(tempRect,190,80,240,130);
  469.         FrameOval(tempRect);
  470.         SetRect(tempRect,10,80,11,130);
  471.         FOR count:=1 TO 25 DO BEGIN
  472.             FrameRect(tempRect);
  473.             OffSetRect(tempRect,4,0);
  474.         END;
  475.     CloseRgn(bRgn);
  476.     cRgn:=NewRgn;
  477.     OpenRgn;
  478.         SetRect(tempRect,60,10,110,60);
  479.         FrameOval(tempRect);
  480.         DrawTriag(120,10);
  481.         DrawTriag(120,80);
  482.         DrawTriag(190,10);
  483.         DrawTriag(190,80);
  484.         MoveTo(60,80);
  485.         Line(50,25);
  486.         Line(-50,25);
  487.         Line(-50,-25);
  488.         Line(50,-25);
  489.     CloseRgn(cRgn);
  490.     TempRgn:=NewRgn;
  491.     
  492. {This Region will always be Red (Background)}
  493.     PmForeColor(0);
  494.     SetRect(tempRect,-32000,-32000,32000,32000);
  495.     PaintRect(tempRect);
  496.     
  497. {This region will start Blue, change Red, stay Red}
  498.     PmForeColor(1);
  499.     DiffRgn(aRgn,bRgn,TempRgn);
  500.     DiffRgn(TempRgn,cRgn,TempRgn);
  501.     PaintRgn(TempRgn);
  502.     
  503. {This region will be Red,Blue,Red}
  504.     PmForeColor(2);
  505.     DiffRgn(bRgn,aRgn,TempRgn);
  506.     DiffRgn(TempRgn,cRgn,TempRgn);
  507.     PaintRgn(TempRgn);
  508.     
  509. {This region will be Blue,Blue,Red}
  510.     PmForeColor(3);
  511.     SectRgn(aRgn,bRgn,TempRgn);
  512.     PaintRgn(TempRgn);
  513.     
  514. {This region will be Red,Red,Blue}
  515.     PmForeColor(4);
  516.     DiffRgn(cRgn,aRgn,TempRgn);
  517.     DiffRgn(TempRgn,bRgn,TempRgn);
  518.     PaintRgn(TempRgn);
  519.     
  520. {This region will be Blue,Red,Blue}
  521.     PmForeColor(5);
  522.     SectRgn(aRgn,cRgn,TempRgn);
  523.     PaintRgn(TempRgn);
  524.     
  525. {This region will be Red,Blue,Blue}
  526.     PmForeColor(6);
  527.     SectRgn(bRgn,cRgn,TempRgn);
  528.     PaintRgn(TempRgn);
  529.     
  530. {This Region will always be Blue}
  531.     PmForeColor(7);
  532.     SectRgn(aRgn,bRgn,TempRgn);
  533.     SectRgn(cRgn,TempRgn,TempRgn);
  534.     PaintRgn(TempRgn);
  535.  
  536.     DisposeRgn(aRgn);
  537.     DisposeRgn(bRgn);
  538.     DisposeRgn(cRgn);
  539.     DisposeRgn(TempRgn);
  540. END;
  541.  
  542. {Animate the Shape image using AnimatePalette/CLUT resouces.}
  543. PROCEDURE AnimShape;
  544. VAR count:INTEGER;
  545.         MyCLUT:ARRAY[1..3] OF CTabHandle;
  546. BEGIN
  547.     FOR count:=1 to 3
  548.         DO MyCLUT[count]:=GetCTable(count+300);
  549.         
  550.     DoDelay(1);
  551.     AnimatePalette(MyWindow[shapeW],MyCLUT[2],0,0,8);
  552.     DoDelay(60);
  553.     AnimatePalette(MyWindow[shapeW],MyCLUT[3],0,0,8);
  554.     DoDelay(60);
  555.     AnimatePalette(MyWindow[shapeW],MyCLUT[1],0,0,8);
  556.     DoDelay(50);
  557.     
  558.     FOR count:=1 TO 5 DO BEGIN
  559.         DoDelay(10);
  560.         AnimatePalette(MyWindow[shapeW],MyCLUT[2],0,0,8);
  561.         DoDelay(10);
  562.         AnimatePalette(MyWindow[shapeW],MyCLUT[3],0,0,8);
  563.         DoDelay(10);
  564.         AnimatePalette(MyWindow[shapeW],MyCLUT[1],0,0,8);
  565.     END;
  566.     
  567.     DoDelay(60);
  568.     
  569.     FOR count:=1 TO 5 DO BEGIN
  570.         DoDelay(1);
  571.         AnimatePalette(MyWindow[shapeW],MyCLUT[2],0,0,8);
  572.         DoDelay(1);
  573.         AnimatePalette(MyWindow[shapeW],MyCLUT[3],0,0,8);
  574.         DoDelay(1);
  575.         AnimatePalette(MyWindow[shapeW],MyCLUT[1],0,0,8);
  576.     END;
  577.  
  578.     FOR count:=1 to 3
  579.         DO DisposCTable(MyCLUT[count]);
  580. END;
  581.  
  582. {******************** Rainbow ********************}
  583.  
  584. {Demonstrates the Rainbow Effect (Rotating Circle,}
  585. {Moving Bands and Expanding Circle).
  586.  
  587. {Create the Rainbow Animation Window.}
  588. PROCEDURE MakeRainbow;
  589. VAR    tempRect : rect;
  590.         tempRGB : RGBColor;
  591.         S : str255;
  592.         tempHSV : HSVColor;
  593.         count : integer;
  594. BEGIN
  595.     SetRect(tempRect, 50, 160, 590, 400);
  596.     GetIndString(S, StrID, 6);
  597.     MyWindow[rainbowW] := NewCWindow(nil, tempRect, S, true, noGrowDocProc, POINTER(-1), true, 0);
  598.     MyPalette[rainbowW] := NewPalette(122, NIL, pmAnimated, 0);
  599.  
  600.     SetRGB(tempRGB,$FFFF,$FFFF,$FFFF);
  601.     SetEntryColor(MyPalette[rainbowW], 0, tempRGB);
  602.     SetRGB(tempRGB,0,0,0);
  603.     SetEntryColor(MyPalette[rainbowW], 1, tempRGB);
  604.     tempHSV.saturation := $FFFF;
  605.     tempHSV.value := $FFFF;
  606.     FOR count := 1 TO 120 DO
  607.         BEGIN
  608.             tempHSV.hue := ($0FFFF*count) DIV 120;
  609.             HSV2RGB(tempHSV, tempRGB);
  610.             SetEntryColor(MyPalette[rainbowW], count+1, tempRGB);
  611.         END;
  612.     SetPalette(MyWindow[rainbowW], MyPalette[rainbowW], true);
  613. END;
  614.  
  615. {Draws the rays of the Rainbow.}
  616. PROCEDURE DoRainbowUpdate;
  617. VAR count:INTEGER;
  618.         tempRect,CRect:Rect;
  619. BEGIN
  620.     SetRect(tempRect, 0, 0, 480, 240);
  621.     PmForeColor(0);
  622.     PaintRect(tempRect);
  623.     SetRect(tempRect, 0, 0, 240, 240);
  624.     SetRect(CRect, 300, 0, 540, 240);
  625.     FOR count := 0 TO 119 DO
  626.         BEGIN
  627.             PmForeColor(count+2);
  628.             PaintArc(tempRect,count*3,3);
  629.             
  630.             MoveTo(240,count);
  631.             Line(60,0);
  632.             MoveTo(240,count+120);
  633.             Line(60,0);
  634.             
  635.             PaintOval(CRect);
  636.             InsetRect(CRect,1,1);
  637.         END;
  638. END;
  639.  
  640. {Rotates all the entries in the CLUT one position.}
  641. PROCEDURE BumpCTEntry(C:CTabHandle);
  642. VAR tempRGB:RGBcolor;
  643.         MyCT : MyCTabHandle;
  644.         count:INTEGER;
  645. BEGIN
  646.     MyCT := POINTER(C);
  647.     WITH MyCT^^ DO BEGIN
  648.         CopyRGB(ctTable[0].rgb,tempRGB);
  649.     
  650.         FOR count:=1 TO ctSize DO 
  651.             CopyRGB(ctTable[count].rgb,ctTable[count-1].rgb);
  652.         
  653.         CopyRGB(tempRGB,ctTable[ctSize].rgb);
  654.     END;
  655. END;
  656.  
  657. {Animate the Rainbow using AnimatePalette.  This one}
  658. {creates and manilpulates it's CLUT directly.}
  659. PROCEDURE AnimRainbow;
  660. VAR count:INTEGER;
  661.         tempRGB : RGBColor;
  662.         tempCT : CTabHandle;
  663. BEGIN
  664.     tempCT := NewCT(120);
  665.     FOR count := 1 TO 120 DO BEGIN
  666.         GetEntryColor(MyPalette[rainbowW],count+1,tempRGB);
  667.         SetCTEntry(tempCT, count-1, tempRGB.red, tempRGB.green, tempRGB.blue);
  668.     END;
  669.  
  670.     FOR count:=1 TO 360 DO BEGIN
  671.         BumpCTEntry(tempCT);
  672.         DoDelay(1);
  673.         AnimatePalette(MyWindow[rainbowW],tempCT,0,2,120);
  674.     END;
  675.     DisposHandle(Handle(tempCT));
  676. END;
  677.  
  678. {******************** Fade ********************}
  679.  
  680. {Demonstrates the Fade effect}
  681.  
  682. {Create the Fade Animation Window (uses Palette resource).}
  683. PROCEDURE MakeFade;
  684. BEGIN
  685.     MyWindow[fadeW] := GetNewCWindow(FadeID, nil, POINTER(-1));
  686. END;
  687.  
  688. {Draws Fade window}
  689. PROCEDURE DoFadeUpdate;
  690. VAR tempRect:Rect;
  691.         count:INTEGER;
  692. BEGIN
  693.     PmForeColor(0);
  694.     SetRect(tempRect,-32000,-32000,32000,32000);
  695.     PaintRect(tempRect);
  696.     
  697.     FOR count:=1 TO 4 DO BEGIN
  698.         PmForeColor(count);
  699.         SetRect(tempRect,((count-1)*100)+10,10,(count*100)-10,90);
  700.         PaintOval(tempRect);
  701.     END;
  702.     
  703.     FOR count:=5 TO 8 DO BEGIN
  704.         PmForeColor(count);
  705.         SetRect(tempRect,((count-5)*100)+10,110,((count-4)*100)-10,190);
  706.         PaintOval(tempRect);
  707.     END;
  708. END;
  709.  
  710. {Animate the Fade.}
  711. PROCEDURE AnimFade;
  712. CONST FadeStep = 60;
  713. VAR count,E:INTEGER;
  714.         Buf,Inc,Start: ARRAY[0..8] OF RGBColor;
  715. BEGIN
  716.     SetRGB(Buf[0],-1,-1,-1);
  717.     SetRGB(Buf[1],0,0,0);
  718.     SetRGB(Buf[2],-1,0,0);
  719.     SetRGB(Buf[3],0,-1,0);
  720.     SetRGB(Buf[4],0,0,-1);
  721.     SetRGB(Buf[5],0,-1,-1);
  722.     SetRGB(Buf[6],-1,0,-1);
  723.     SetRGB(Buf[7],-1,-1,0);
  724.     SetRGB(Buf[8],30000,30000,30000);
  725.     FOR E:=0 TO 8 DO BEGIN
  726.         CopyRGB(Buf[E],Start[E]);
  727.         UnSignedDiv(Buf[E].Red,FadeStep,Inc[E].Red);
  728.         UnSignedDiv(Buf[E].Green,FadeStep,Inc[E].Green);
  729.         UnSignedDiv(Buf[E].Blue,FadeStep,Inc[E].Blue);
  730.     END;
  731.  
  732.     FOR count:=FadeStep-1 DOWNTO 1 DO BEGIN
  733.         FOR E:=0 TO 8 DO BEGIN
  734.             DoDelay(1);
  735.             UnSignedSub(Buf[E].Red,Inc[E].Red);
  736.             UnSignedSub(Buf[E].Green,Inc[E].Green);
  737.             UnSignedSub(Buf[E].Blue,Inc[E].Blue);
  738.             AnimateEntry(MyWindow[fadeW],E,Buf[E]);
  739.         END;
  740.     END;
  741.     
  742.     DoDelay(1);
  743.     FOR E:=0 TO 8 DO BEGIN
  744.         SetRGB(Buf[E],0,0,0);
  745.         AnimateEntry(MyWindow[fadeW],E,Buf[E]);
  746.     END;
  747.  
  748.     DoDelay(90);
  749.  
  750.     FOR count:=1 TO FadeStep-1 DO BEGIN
  751.         FOR E:=0 TO 8 DO BEGIN
  752.             DoDelay(1);
  753.             UnSignedAdd(Buf[E].Red,Inc[E].Red);
  754.             UnSignedAdd(Buf[E].Green,Inc[E].Green);
  755.             UnSignedAdd(Buf[E].Blue,Inc[E].Blue);
  756.             AnimateEntry(MyWindow[fadeW],E,Buf[E]);
  757.         END;
  758.     END;
  759.     
  760.     DoDelay(1);
  761.     FOR E:=0 TO 8 
  762.         DO AnimateEntry(MyWindow[fadeW],E,Buf[E]);
  763. END;
  764.  
  765. {******************** Main Portion Programs ********************}
  766.  
  767. {Set Up the normal Mac Interface}
  768. PROCEDURE SetUp;
  769. VAR    count : integer;
  770. BEGIN
  771. {Standard Mac Program setup}
  772.     InitGraf(@thePort);
  773.     InitFonts;
  774.     FlushEvents(everyEvent, 0);
  775.     InitWindows;
  776.     InitMenus;
  777.     TEInit;
  778.     InitDialogs(NIL);
  779.     InitCursor;
  780.  
  781.     FOR count := appleM TO menuCount DO
  782.         myMenus[count] := GetMenu(count);
  783.     AddResMenu(myMenus[appleM], 'DRVR');
  784.     FOR count := appleM TO menuCount DO
  785.         InsertMenu(myMenus[count], 0);
  786.     DrawMenuBar;
  787.  
  788.     WITH screenBits.bounds DO
  789.         SetRect(dragRect, 4, 24, right - 4, bottom - 4);
  790.     doneFlag := FALSE;
  791.     
  792.     FOR count:=1 TO numWindows DO BEGIN
  793.         MyWindow[count]:=NIL;
  794.         MyPalette[count]:=NIL;
  795.     END;
  796. END;
  797.  
  798. {Given a Window ID number, close Window/Palette}
  799. PROCEDURE CloseIt (N:INTEGER);
  800. BEGIN
  801.     IF (N>0) AND (N<=numWindows) THEN BEGIN
  802.         IF MyPalette[N] <> NIL THEN
  803.             DisposePalette(MyPalette[N]);
  804.         MyPalette[N]:=NIL;
  805.         IF MyWindow[N]<> NIL THEN
  806.             DisposeWindow(MyWindow[N]);
  807.         MyWindow[N]:=NIL;
  808.     END;
  809. END;
  810.  
  811. {Gets the Front most Window ID number.}
  812. FUNCTION GetWindowNum(W:WindowPtr):INTEGER;
  813. VAR N,count:INTEGER;
  814. BEGIN
  815.     IF W=NIL
  816.         THEN GetWindowNum:=0
  817.     ELSE  BEGIN
  818.         N:=0;
  819.         FOR count:=1 TO numWindows
  820.             DO IF MyWindow[count]=W
  821.                 THEN N:=count;
  822.         GetWindowNum:=N;
  823.     END;
  824. END;
  825.  
  826. {Standard Handling of the Menu.  Selecting the Window Menu, bring that window}
  827. {    to the front and that's all (Palette Manager handles changing colors and}
  828. {    creating update).  Animate Menu animate the front window if it can.}
  829. PROCEDURE DoCommand (mResult : LONGINT);
  830.     VAR
  831.         theItem : INTEGER;
  832.         theMenu : INTEGER;
  833.         name : Str255;
  834.         N : INTEGER;
  835.         dummy : Boolean;
  836.         tempPort:GrafPtr;
  837. BEGIN
  838.     theItem := LoWord(mResult);
  839.     theMenu := HiWord(mResult);
  840.     CASE theMenu OF
  841.         appleM : 
  842.             IF theItem = 1 THEN
  843.                 theItem := Alert(AlertID, NIL)
  844.             ELSE
  845.                 BEGIN
  846.                     GetItem(myMenus[appleM], theItem, name);
  847.                     N := OpenDeskAcc(name);
  848.                 END;
  849.         fileM : CASE theItem OF
  850.             1: BEGIN
  851.                 GetPort(tempPort);
  852.                 SetPort(FrontWindow);
  853.                 CASE GetWindowNum(FrontWindow) OF
  854.                     ballW : AnimBall;
  855.                     shapeW : AnimShape;
  856.                     rainbowW : AnimRainbow;
  857.                     fadeW : AnimFade;
  858.                     OTHERWISE
  859.                 END;
  860.                 SetPort(tempPort);
  861.             END;
  862.             2: CloseIt(GetWindowNum(FrontWindow));
  863.             4: doneFlag := TRUE;
  864.             otherwise
  865.         END;
  866.         editM : 
  867.             dummy := SystemEdit(theItem - 1);
  868.         winM : IF (theItem>0) and (theItem<=numWindows) THEN BEGIN
  869.                 IF MyWindow[theItem]=NIL THEN BEGIN
  870.                     CASE theItem OF
  871.                         redW : 
  872.                             MakeRed;
  873.                         greenW : 
  874.                             MakeGreen;
  875.                         blueW : 
  876.                             MakeBlue;
  877.                         ballW : 
  878.                             MakeBall;
  879.                         curW : 
  880.                             MakeCur;
  881.                         shapeW : 
  882.                             MakeShape;
  883.                         rainbowW : 
  884.                             MakeRainbow;
  885.                         fadeW : 
  886.                             MakeFade;
  887.                         OTHERWISE
  888.                     END;
  889.                 END
  890.                 ELSE SelectWindow(MyWindow[theItem]);
  891.         END;
  892.         OTHERWISE
  893.     END;
  894.     HiliteMenu(0);
  895. END;
  896.  
  897. {Extremely Standard Main Program Loop.}
  898. PROCEDURE DoMainLoop;
  899.     VAR
  900.         theChar : CHAR;
  901.         myEvent : EventRecord;
  902.         whichWindow : WindowPtr;
  903.         oldPort : GrafPtr;
  904.         dummy : boolean;
  905. BEGIN
  906.     REPEAT
  907.         SystemTask;
  908.         IF GetNextEvent(everyEvent, myEvent) THEN
  909.             CASE myEvent.what OF
  910.                 mouseDown : 
  911.                     CASE FindWindow(myEvent.where, whichWindow) OF
  912.                         inSysWindow : 
  913.                             SystemClick(myEvent, whichWindow);
  914.                         inMenuBar : 
  915.                             DoCommand(MenuSelect(myEvent.where));
  916.                         inGoAway: IF TrackGoAway(whichWindow,myEvent.where)
  917.                             THEN CloseIt(GetWindowNum(whichWindow));
  918.                         inDrag : 
  919.                             IF (FrontWindow <> whichWindow) THEN
  920.                                 SelectWindow(whichWindow)
  921.                             ELSE
  922.                                 DragWindow(whichWindow, myEvent.where, dragRect);
  923.                         inContent : 
  924.                             IF (FrontWindow <> whichWindow) THEN
  925.                                 SelectWindow(whichWindow);
  926.                         OTHERWISE
  927.                     END; {of mouseDown}
  928.                 keyDown, autoKey : 
  929.                     BEGIN
  930.                         theChar := CHR(BitAnd(myEvent.message, charCodeMask));
  931.                         IF BitAnd(myEvent.modifiers, cmdKey) <> 0 THEN
  932.                             DoCommand(MenuKey(theChar));
  933.                     END;
  934.                 updateEvt : 
  935.                     BEGIN
  936.                         whichWindow := WindowPtr(myEvent.message);
  937.                         IF whichWindow <> NIL THEN
  938.                             BEGIN
  939.                                 GetPort(oldPort);
  940.                                 SetPort(whichWindow);
  941.                                 BeginUpdate(whichWindow);
  942.                                 CASE GetWindowNum(whichWindow) OF
  943.                                     redW: DoRedUpdate;
  944.                                     greenW: DoGreenUpdate;
  945.                                     blueW: DoBlueUpdate;
  946.                                     curW: DoCurUpdate;
  947.                                     ballW: DoBallUpdate;
  948.                                     shapeW: DoShapeUpdate;
  949.                                     rainbowW: DoRainbowUpdate;
  950.                                     fadeW: DoFadeUpdate;
  951.                                     OTHERWISE
  952.                                 END;
  953.                                 EndUpdate(whichWindow);
  954.                                 SetPort(oldPort);
  955.                             END;
  956.                     END;
  957.                 OTHERWISE
  958.             END;
  959.     UNTIL doneFlag;
  960. END;
  961.  
  962. {Dispose of all the Palettes and closes all the Windows.}
  963. PROCEDURE CloseDown;
  964.     VAR
  965.         count : integer;
  966. BEGIN
  967.     FOR count:=1 TO numWindows
  968.         DO CloseIt(count);
  969.     FOR count := appleM TO menuCount DO
  970.         BEGIN
  971.             DeleteMenu(count);
  972.             DisposeMenu(myMenus[count]);
  973.         END;
  974.     DrawMenuBar;
  975. END;
  976.  
  977. {Main Body Program.  Setup, Do it, Close down.}
  978. BEGIN
  979.     IF ColorQDExists THEN BEGIN
  980.         SetUp;
  981.         DoMainLoop;
  982.         CloseDown;
  983.     END;
  984. END.
  985.